;; osc-receiver.scm - (c) rohan drape, 2003-2005

;; Instances of <osc-transport> route all incoming OSC packets through
;; osc-receiver-dispatch.  OSC receivers behave like MIDI receivers.
;; OSC responders provides one slot only overwriting receivers with
;; equality predicates.

;; The global table of registered OSC receivers.  The key is the
;; receiver procedure, the value the predicate procedure.

(define-global osc-receiver-table (make-table))

;; Register the three argument `receiver' to receive incoming OSC
;; packets that match the criteria mask `command'.  The criteria mask
;; may be a <string> value for direct comparison, a proper <list> of
;; <string>s for direct membership test, a one argument predicate
;; <procedure>, or the <boolean> value '#t' to match all incoming
;; messages.  The argument to `receiver' is the lisp representation of
;; the OSC message.  Note that the receiver is executed in the
;; <osc-transport> thread.

(define (osc-receiver-register command receiver)
  (define (make-canonical-test test type? equal?)
    (cond ((and (boolean? test) test)
	   (lambda (value) #t))
	  ((type? test)
	   (lambda (value) (equal? value test)))
	  ((list? test)
	   (lambda (value) (member* value test equal?)))
	  ((procedure? command)
	   command)
	  (else
	   (error "make-canonical-test: Bad test value" test))))
  (table-put! (osc-receiver-table)
	      receiver
	      (make-canonical-test command 
				   string? 
				   string=?)))

;; Delete `procedure' from the set of registered reponders.

(define (osc-receiver-unregister receiver)
  (table-remove! (osc-receiver-table) receiver))

;; Clear all entries from the receiver list.

(define (osc-receiver-clear)
  (table-clear! (osc-receiver-table)))

;; The dispatch procedure that receives all incoming OSC byte packets
;; and calls the appropriate registered receivers.

(define (osc-receiver-dispatch packet)
  (define (handle-message pkt)
    (table-for-each 
     (lambda (receiver predicate)
       (if (predicate (car pkt))
	   (receiver pkt)))
     (osc-receiver-table)))
  (define (handle-bundle pkt)
    (for-each handle-packet (cdr pkt)))
  (define (handle-packet pkt)
    (if (osc-lisp-message? pkt)
	(handle-message pkt)
	(handle-bundle pkt)))
  (handle-packet (osc-decode-packet packet)))

;; Block until a matching OSC packet arrives.  Returns the incoming
;; OSC packet.

(define (osc-wait command)
  (let* ((semaphore (make-semaphore))
	 (result #f)
	 (receiver (lambda (packet)
		     (set! result packet)
		     (semaphore-post semaphore))))
    (osc-receiver-register command receiver)
    (semaphore-wait semaphore)
    (osc-receiver-unregister receiver)
    result))
